home *** CD-ROM | disk | FTP | other *** search
- 3 DEFDBL X
- 4 DEFINT A-W,Y-Z
- 5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
- 10 DIM X$(30),Y$(30)
- 13 DIM L(15),NREC(15),Z$(30),EGL(30),KT(30),I#(30,10),I$(30,10),ORN(30)
- 14 DIM X(30),CK$(30),SN$(30),SFN(30)
- 16 DIM KY(15,30),KEYLIST(15,30),L$(10,100),LEND(30),CL(30)
- 17 DIM ORNFLG(30),FTA(30),ATF(30),BTF(30),IMAX(30)
- 18 DIM SU%(40),S!(30),SUM#(40)
- 20 DIM XL(40)
- 22 DIM ORFLG(30),D(30),TFN(30),KTSUM(30),SUMFN(30)
- 25 DIM S#(30)
- 26 DIM MAX(10),Z%(30),SU#(30),D#(30),EFN(10,30)
- 35 DIM K$(80)
- 42 DIM MAXK(30),SUMRN(5,5),SUMFLDN(10,5),MAXSAF(9)
- 60 DIM SAF#(3,200)
- 61 CH = 29: PRINT FRE(0)
- 70 NE = 0
- 75 GOSUB 50000
- 80 GOSUB 10000
- 90 GOSUB 11000
- 400 GOSUB 13000
- 402 IF KD < 5 THEN GOSUB 11000
- 404 GOSUB 13000
- 410 PRINT "****** SELECTIVE SCAN PROGRAM -- WHAT FILE DO YOU WANT: *****"
- 420 PRINT ""
- 425 PRINT " 0 - *** EXIT PROGRAM ***"
- 430 FOR I = 1 TO MAXF
- 440 PRINT I;" - ";F$(I)
- 450 NEXT I
- 460 PRINT ""
- 470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
- 475 GOSUB 14000
- 477 IF DT# < 0 OR DT#>MAXF GOTO 475
- 480 A = DT#
- 482 IF A = 0 GOTO 51000
- 483 GOSUB 13000
- 484 PRINT "FILE : "; F$(A)
- 485 GOSUB 2300
- 490 GOSUB 2500
- 500 GOTO 6000
- 2300 REM ************** DISK SELECTION ***************
- 2302 IF HDISK = 2 THEN GOSUB 13000
- 2303 IF HDISK = 2 THEN GOTO 2360
- 2304 PRINT ""
- 2305 PRINT "************ WHICH DISK DRIVE IS THE FILE ON **************"
- 2310 PRINT ""
- 2315 PRINT " 1 - DISK DRIVE A"
- 2320 PRINT " 2 - DISK DRIVE B"
- 2325 PRINT " 3 - DISK DRIVE C"
- 2330 PRINT " 4 - DISK DRIVE D"
- 2335 PRINT ""
- 2340 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ************"
- 2345 GOSUB 14000
- 2347 IF DT# < 0 OR DT#>4 GOTO 2345
- 2350 T = DT#
- 2355 ON T GOTO 2360,2370,2380,2390
- 2360 T$ = F$(A)
- 2365 GOTO 2490
- 2370 T$ = "B:"+F$(A)
- 2375 GOTO 2490
- 2380 T$ = "C:"+F$(A)
- 2385 GOTO 2490
- 2390 T$ = "D:"+F$(A)
- 2490 RETURN
- 2500 REM ******* OPEN FILE SUBROUTINE *******
- 2503 CLOSE #1
- 2505 OPEN "R",#1,T$,L(A)
- 2507 D = 0
- 2510 FOR T = 1 TO NREC(A)
- 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
- 2530 D = D + FL(A,T)
- 2540 NEXT T
- 2543 GOSUB 7800
- 2545 RETURN
- 2550 REM ******* OPEN SECOND FILE *******
- 2553 CLOSE #2
- 2555 OPEN "R",#2,T$,L(B)
- 2557 D = 0
- 2560 FOR T = 1 TO NREC(B)
- 2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T)
- 2570 D = D + FL(B,T)
- 2575 NEXT T
- 2578 RETURN
- 2580 REM ******* OPEN THIRD FILE *******
- 2582 PRINT C,F$(C),L(C)
- 2584 OPEN "R",#2,F$(C),L(C)
- 2586 D = 0
- 2588 FOR T = 1 TO NREC(C)
- 2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
- 2592 D = D + FL(C,T)
- 2594 NEXT T
- 2596 RETURN
- 3010 GOTO 400
- 6000 REM ********** LOOP THROUGH FIELDS ************
- 6001 EFLG = 0:GOSUB 10700
- 6002 GOSUB 10200
- 6003 FOR Q = 1 TO NREC(A)
- 6006 GOSUB 6045
- 6009 NEXT Q
- 6010 REM ********* ADD OPTIONS *******
- 6011 GOSUB 6603
- 6012 REM ********** GET STARTING RECORD **********
- 6015 GOSUB 6375
- 6018 REM ********** GET RECORDS ***********
- 6021 RN = RN - 1
- 6024 RN = RN + 1
- 6027 GOSUB 6090
- 6029 IF MATCH = 0 THEN PRINT "RECORD NUMBER ";RN ;" CONDITIONS NOT MET"
- 6030 IF MATCH = 0 GOTO 6024
- 6033 IF ADOPT > 1 THEN GOSUB 6759
- 6036 REM ******** PRINT ON PAPER ********
- 6039 IF PRTOPT <> 1 THEN GOSUB 12000
- 6040 IF PRTOPT = 1 THEN GOSUB 12200
- 6042 GOTO 6024
- 6045 REM *********** LOOP THROUGH FIELDS ************
- 6048 GOSUB 6129
- 6050 IF EGL(Q) = 1 THEN RETURN
- 6051 IF FTY(A,Q) = 1 THEN GOTO 6069
- 6057 REM ****** NUMBERS ********
- 6060 ON EGL(Q) GOSUB 6045,6201,6234,6234,6201
- 6063 GOTO 6075
- 6066 REM ****** STRINGS *******
- 6069 ON EGL(Q) GOSUB 6366,6246,6279,6279,6246
- 6072 REM ********** OR ROUTINE ******
- 6075 GOSUB 6288
- 6078 IF DT# = 2 THEN GOSUB 6324
- 6087 RETURN
- 6090 REM ************** GET RECORDS *****************
- 6093 GOSUB 6396
- 6096 FOR Q = 1 TO NREC(A)
- 6099 REM *********** CONVERT STRINGS TO DECIMALS *********
- 6102 GOSUB 6435
- 6105 IF TEST = 1 THEN GOTO 6123
- 6108 IF TEST = 0 THEN GOSUB 6561
- 6111 REM ******* OR CHECK RESULTS *********
- 6114 IF TEST = 1 THEN GOTO 6123
- 6117 MATCH = 0
- 6120 RETURN
- 6123 NEXT Q
- 6124 MATCH = 1
- 6126 RETURN
- 6129 GOSUB 13000
- 6138 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
- 6141 K = 0
- 6147 PRINT "****************** CHOSE A RELATIONSHIP *******************"
- 6153 PRINT " 0 - RETURN TO FILE OPTIONS "
- 6156 PRINT " 1 - ANY VALUE IS ACCEPTABLE"
- 6159 PRINT " 2 - ";FLDN$(A,Q);" EQUAL TO X"
- 6162 PRINT " 3 - ";FLDN$(A,Q);" GREATER THEN X"
- 6165 PRINT " 4 - ";FLDN$(A,Q);" LESS THEN X"
- 6166 PRINT " 5 - ";FLDN$(A,Q);" BETWEEN X AND Y"
- 6171 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
- 6177 REM ******* EGL MEANS EQUAL GREATER OR LESS THEN *****
- 6180 GOSUB 14000
- 6181 IF DT# < 0 OR DT#>5 GOTO 6180
- 6183 EGL(Q) = DT#
- 6189 IF EGL(Q) = 0 GOTO 3010
- 6192 RETURN
- 6195 IF FTY(A,Q)=1 THEN GOTO 6243
- 6198 ON EGL(Q) GOTO 6366,6201,6234,6234,6201
- 6201 PRINT "********** ENTER THE VALUE OF X THEN PRESS RETURN **********"
- 6204 K = K + 1
- 6207 KT(Q)=K
- 6209 GOSUB 14300
- 6210 I#(Q,K) = DT#
- 6211 IF EGL(Q) = 5 AND K = 2 THEN RETURN
- 6212 IF EGL(Q) = 5 THEN PRINT "********** ENTER THE VALUE OF Y THEN PRESS RETURN **********"
- 6213 IF EGL(Q) = 5 GOTO 6204
- 6215 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
- 6216 PRINT " 1 - MORE VALUES OF X "
- 6219 PRINT " 2 - NO MORE VALUES OF X "
- 6222 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
- 6225 GOSUB 14000
- 6226 IF DT# <1 OR DT# > 2 GOTO 6225
- 6228 IF DT# = 1 GOTO 6201
- 6231 RETURN
- 6234 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN ********"
- 6235 GOSUB 14300
- 6237 I#(Q,1) = DT#
- 6240 RETURN
- 6243 ON EGL(Q) GOTO 6366,6246,6279,6279
- 6246 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
- 6249 K = K + 1
- 6252 KT(Q)=K
- 6253 MAX = 30
- 6254 GOSUB 15030
- 6255 I$(Q,K) = A$
- 6256 IF EGL(Q) = 5 AND K = 2 THEN RETURN
- 6257 IF EGL(Q) = 5 THEN PRINT "******* ENTER THE VALUE OF Y THEN PRESS RETURN *******"
- 6258 IF EGL(Q) = 5 THEN GOTO 6249
- 6260 PRINT "*************** MUTIPLE VALUES OF X ? *****************"
- 6261 PRINT " 1 - MORE VALUES OF X "
- 6264 PRINT " 2 - NO MORE VALUES OF X "
- 6267 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********"
- 6270 GOSUB 14000
- 6271 IF DT# <1 OR DT# >2 GOTO 6270
- 6273 IF DT# = 1 GOTO 6246
- 6276 RETURN
- 6279 PRINT "******* ENTER THE VALUE OF X THEN PRESS RETURN *******"
- 6280 MAX = 30
- 6281 GOSUB 15030
- 6282 I$(Q,1) = A$
- 6285 RETURN
- 6288 REM ************** OR / AND ROUTINE **************
- 6290 IF Q = NREC(A) THEN RETURN
- 6291 PRINT ""
- 6294 PRINT "***** DO YOU WANT THIS CONDITON ORed WITH ANOTHER CONDITION ****"
- 6297 PRINT " 1 - NO, THIS CONDITION MUST BE MEET "
- 6300 PRINT " 2 - YES, CHECK ANOTHER FIELD TO SEE IF IT MEETS IT'S CONDITION"
- 6303 PRINT " - Use only on the lower number field of the 2 you want to or"
- 6306 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
- 6309 GOSUB 14000
- 6310 IF DT# <1 OR DT# >2 GOTO 6309
- 6315 ORN(Q) = 0
- 6318 RETURN
- 6321 IF A$ ="1" GOTO 6366
- 6324 GOSUB 13000
- 6327 PRINT "-------------------- OR OPTION --------------------------"
- 6333 PRINT "************** WHAT FIELD DO YOU WANT ? ******************"
- 6336 PRINT "FIELD NUMBER: ";Q;"FIELD NAME: ";FLDN$(A,Q)
- 6339 PRINT "******************** ORed WITH ***************************"
- 6345 FOR N = (Q+1) TO NREC(A)
- 6348 PRINT "FIELD NUMBER: ";N;"FIELD NAME: ";FLDN$(A,N)
- 6351 NEXT N
- 6357 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
- 6360 GOSUB 14000
- 6361 IF DT# <(Q+1) OR DT# > NREC(A) GOTO 6360
- 6363 ORN(Q) = DT#
- 6366 RETURN
- 6369 GOSUB 6603
- 6372 F4 = 23
- 6375 GOSUB 13000
- 6378 PRINT "******** WHAT RECORD DO YOU WANT TO START AT *********"
- 6381 PRINT ""
- 6384 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********"
- 6387 GOSUB 14100
- 6388 IF DT# <1 OR DT# > 10000 GOTO 6387
- 6390 RN = DT#
- 6393 RETURN
- 6396 REM GET RECORD
- 6399 IF INKEY$ <> "" THEN GOSUB 6576
- 6402 IF RN > MRN THEN GOSUB 26500
- 6403 IF EFLG = 1 GOTO 6810
- 6405 GET #1,RN
- 6417 FOR J = 1 TO NREC(A)
- 6420 ORFLG(J) = 0
- 6423 NEXT J
- 6426 RETURN
- 6429 Q = Q + 1
- 6432 REM
- 6435 ON FTY(A,Q) GOTO 6507,6441,6453,6465,6465
- 6438 REM ************** CONVERT STRINGS TO DECIMALS ****************
- 6441 I%=CVI(X$(Q))
- 6444 I# = I%
- 6447 S#(Q) = I#
- 6450 GOTO 6471
- 6453 I!=CVS(X$(Q))
- 6456 I# = I!
- 6459 S#(Q) = I#
- 6462 GOTO 6471
- 6465 I#=CVD(X$(Q))
- 6468 S#(Q) = I#
- 6471 IF ORFLG(Q) = 1 GOTO 6546
- 6474 REM ************** CHECK NUMBERS FOR RELATIONS ***************
- 6477 ON EGL(Q) GOTO 6546,6480,6492,6498,6502
- 6480 FOR K = 1 TO KT(Q)
- 6483 IF I#=I#(Q,K) GOTO 6546
- 6486 NEXT K
- 6489 GOTO 6561
- 6492 IF I#>I#(Q,1) GOTO 6546
- 6495 GOTO 6561
- 6498 IF I# < I#(Q,1) GOTO 6546
- 6501 GOTO 6561
- 6502 IF I# > I#(Q,1) AND I# < I#(Q,2) GOTO 6546
- 6503 GOTO 6561
- 6504 REM **************CHECK STRINGS FOR RELATIONS **************
- 6507 ON EGL(Q) GOTO 6546,6510,6534,6540,6544
- 6510 FOR K = 1 TO KT(Q)
- 6513 Y$ = I$(Q,K)
- 6516 Y = LEN(Y$)
- 6519 X$ = X$(Q)
- 6522 X$ = LEFT$(X$,Y)
- 6525 IF X$=I$(Q,K) GOTO 6546
- 6528 NEXT K
- 6531 GOTO 6561
- 6534 IF X$(Q) > I$(Q,1) GOTO 6546
- 6537 GOTO 6561
- 6540 IF X$(Q) < I$(Q,1) GOTO 6546
- 6543 GOTO 6561
- 6544 IF X$(Q) > I$(Q,1) AND X$(Q) < I$(Q,2) GOTO 6546
- 6545 GOTO 6561
- 6546 P = ORN(Q)
- 6549 IF P = 0 GOTO 6555
- 6552 ORFLG(P) = 1
- 6555 TEST = 1
- 6558 RETURN
- 6561 TEST = 0
- 6567 IF ORN(Q) <> O THEN TEST = 1 ELSE TEST = 2
- 6573 RETURN
- 6576 REM ******** PAUSE SUBROUTINE ********
- 6579 PRINT "****************** PAUSE SUBROUTINE **********************"
- 6582 PRINT " 1 - CONTINUE SCANNING"
- 6585 PRINT " 0 - STOP SCANNING "
- 6588 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
- 6591 GOSUB 14000
- 6593 IF DT# <0 OR DT# >1 GOTO 6588
- 6597 IF DT# = 0 THEN GOTO 6810
- 6600 RETURN
- 6603 REM ******* ADD OPTIONS FOR THE SELECTIVE SCAN ROUTINE *******
- 6606 GOSUB 13000
- 6609 PRINT "******************** ADD OPTIONS ***********************"
- 6612 PRINT ""
- 6615 PRINT " 1 - DO NOT ADD"
- 6618 PRINT " 2 - ADD FIELDS"
- 6621 PRINT " 3 - ADD FIELDS WITH SUBTOTALS BY ANOTHER FIELD "
- 6624 PRINT " 4 - BOTH 2 & 3"
- 6627 PRINT ""
- 6630 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ***********"
- 6633 GOSUB 14000
- 6634 IF DT# <1 OR DT# >4 GOTO 6633
- 6636 ADOPT = DT#
- 6637 IF ADOPT > 1 THEN GOSUB 10600
- 6639 ON ADOPT GOTO 6756,6642,6696,6642
- 6642 GOSUB 13000
- 6645 PRINT "********** HOW MANY FIELDS DO YOU WANT TO ADD **********"
- 6648 PRINT ""
- 6651 FOR T = 1 TO NREC(A)
- 6654 PRINT T;" - ";FLDN$(A,T)
- 6657 NEXT T
- 6660 PRINT "********** HOW MANY FIELDS DO YOU WANT TO ADD **********"
- 6663 GOSUB 14000
- 6664 IF DT# <1 OR DT#> NREC(A) GOTO 6663
- 6666 KTSUM = DT#
- 6669 FOR T = 1 TO KTSUM
- 6672 PRINT "***** WHICH FIELD IS THE ";T;"th YOU WAMT TO ADD *****"
- 6675 GOSUB 14000
- 6676 IF DT# <1 OR DT#> NREC(A) GOTO 6675
- 6677 IF FTY(A,DT#) = 1 GOTO 6675
- 6678 FTA(T) = DT#
- 6681 NEXT T
- 6684 FOR T = 1 TO KTSUM
- 6687 SUM#(T) = 0
- 6690 NEXT T
- 6693 IF ADOPT = 2 GOTO 6756
- 6696 GOSUB 13000
- 6699 PRINT "*** HOW MANY FIELDS DO YOU WANT TO SUBTOTAL BY ANOTHER FIELD ***"
- 6702 PRINT ""
- 6705 FOR T = 1 TO NREC(A)
- 6708 PRINT T;" - ";FLDN$(A,T)
- 6711 NEXT T
- 6714 PRINT ""
- 6717 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN ***************"
- 6720 GOSUB 14000
- 6721 IF DT#<1 OR DT#>NREC(A) GOTO 6720
- 6723 KTSAF = DT#
- 6724 FOR T = 1 TO KTSAF
- 6725 PRINT "**** WHICH FIELD IS THE ";T;" th FIELD YOU WANT TO SUBTOTAL ****"
- 6726 GOSUB 14000
- 6727 IF DT#<1 OR DT#>NREC(A) GOTO 6726
- 6728 IF FTY(A,DT#) = 1 GOTO 6726
- 6731 ATF(T) = DT#
- 6732 PRINT "********* WHICH FIELD DO YOU WANT SUBTOTALS GROUPED BY *********"
- 6733 PRINT " Must be an interger field "
- 6734 GOSUB 14000
- 6735 IF DT#<1 OR DT#>NREC(A) GOTO 6734
- 6736 IF FTY(A,DT#) <> 2 GOTO 6734
- 6737 BTF(T) = DT#
- 6738 IMAX(T) = 0
- 6739 NEXT T
- 6741 FOR T = 1 TO KTSAF
- 6744 FOR I = 1 TO 99
- 6747 SAF#(T,I) = 0
- 6750 NEXT I
- 6753 NEXT T
- 6756 RETURN
- 6759 REM ***** ADD SUBROUTINE *******
- 6765 IF ADOPT = 3 GOTO 6783
- 6768 FOR T = 1 TO KTSUM
- 6771 F = FTA(T)
- 6774 SUM#(T) = SUM#(T) + S#(F)
- 6777 NEXT T
- 6780 IF ADOPT = 2 THEN RETURN
- 6783 REM ****** ADD ACCORDING TO ANOTHER FIELD *******
- 6786 FOR T = 1 TO KTSAF
- 6789 T1 = ATF(T)
- 6792 T2 = BTF(T)
- 6793 IF T2 <= 0 THEN T2 = 99
- 6794 IF T2 >100 THEN T2 = 99
- 6795 T3 = S#(T2)
- 6797 IF T3 > IMAX(T) THEN IMAX(T) = T3
- 6798 SAF#(T,T3) = SAF#(T,T3) + S#(T1)
- 6804 NEXT T
- 6807 RETURN
- 6810 REM ******* PRINT SUMS ***********
- 6813 EFLG = 0
- 6819 IF ADOPT = 1 GOTO 3010
- 6825 PRINT "*********** PRINT SUMS ***********"
- 6828 IF ADOPT = 3 GOTO 6858
- 6831 PRINT "********* FIELD SUMS ***********"
- 6834 FOR T = 1 TO KTSUM
- 6837 T2 = FTA(T)
- 6840 PRINT FLDN$(A,T2),SUM#(T)
- 6841 IF SPRT = 2 THEN LPRINT FLDN$(A,T2),SUM#(T)
- 6843 NEXT T
- 6846 PRINT ""
- 6849 PRINT "PRESS ANY KEY TO CONTINUE "
- 6852 IF INKEY$ = "" GOTO 6852
- 6855 IF ADOPT = 2 GOTO 3010
- 6858 PRINT "****** SUM ACCORDING TO ANOTHER FIELD ********"
- 6861 FOR T = 1 TO KTSAF
- 6864 T2 = ATF(T)
- 6867 T3 = BTF(T)
- 6870 PRINT "SUM OF THIS FIELD :";FLDN$(A,T2)
- 6871 IF SPRT = 2 THEN LPRINT "SUM OF THIS FIELD :";FLDN$(A,T2)
- 6873 PRINT "SUBTOTALS BY FIELD :";FLDN$(A,T3)
- 6874 IF SPRT = 2 THEN LPRINT "SUBTOTALS BY FIELD :";FLDN$(A,T3)
- 6876 FOR I = 1 TO IMAX(T)
- 6879 PRINT I;"-";SAF#(T,I)
- 6880 IF SPRT = 2 THEN LPRINT I;"-";SAF#(T,I)
- 6882 NEXT I
- 6885 PRINT "PRESS ANY KEY TO CONTINUE "
- 6888 IF INKEY$ = "" GOTO 6888
- 6891 NEXT T
- 6894 GOTO 3010
- 7800 MRN = LOF(1)/ L(A)
- 7805 REM MRN = INT(MRN)
- 7810 RETURN
- 7900 REM ***** LOF
- 7910 MRN2 = LOF(3)/82
- 7920 RETURN
- 7950 REM ******* LOF
- 7960 MRNS = LOF(B)/L(B)
- 7970 RETURN
- 10000 REM ************* READ SUBROUTINE *************
- 10004 GOSUB 10900
- 10010 OPEN "I",#1,"FFILE"
- 10020 INPUT #1,MAXF
- 10030 FOR A = 1 TO MAXF
- 10040 INPUT #1,A,F$(A),NREC(A),L(A)
- 10050 FOR N = 1 TO NREC(A)
- 10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
- 10070 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
- 10080 NEXT N
- 10090 NEXT A
- 10100 CLOSE #1
- 10110 RETURN
- 10200 REM ******* SELECTIVE SCAN CONTINUED ********
- 10210 GOSUB 13000
- 10220 PRINT "**************** SELECTIVE SCAN PROGRAM *****************"
- 10230 PRINT ""
- 10240 PRINT "******** WHAT DO YOU WANT DONE WITH THE RESULTS *********"
- 10250 PRINT ""
- 10260 PRINT " 1 - SHOWN ON THE MONITOR (TV) ONLY "
- 10370 PRINT " 2 - PRINT ON PAPER AND SHOWN ON THE MONITOR "
- 10400 PRINT ""
- 10500 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ***********"
- 10510 GOSUB 14000
- 10512 IF DT# <1 OR DT# >2 GOTO 10510
- 10520 IF DT# = 2 THEN PRTOPT = 1 ELSE PRTOPT = 0
- 10530 RETURN
- 10600 REM ******** SELECTIVE SCAN CONTINUED *********
- 10610 GOSUB 13000
- 10620 PRINT "************** DO YOU WANT THE SUMS **************"
- 10630 PRINT ""
- 10640 PRINT " 1 - SHOWN ON THE MONITOR (TV) ONLY "
- 10650 PRINT " 2 - PRINT ON PAPER AND SHOW ON THE MONITOR "
- 10660 PRINT ""
- 10670 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********"
- 10680 GOSUB 14000
- 10682 IF DT# <1 OR DT# >2 GOTO 10680
- 10690 SPRT = DT#
- 10695 RETURN
- 10700 REM ****** SELECTIVE SCAN INTRO
- 10705 GOSUB 13000
- 10710 PRINT "************************* SELECTIVE SCAN ROUTINE ************************"
- 10720 PRINT ""
- 10730 PRINT " The selective scan routine will display each field in the file then ask"
- 10740 PRINT "you what conditons if any you want to place on the field. You may place "
- 10750 PRINT "a conditon on every field if you wish to do so. "
- 10755 PRINT ""
- 10760 PRINT " The computer will then display only the records that meet the conditions"
- 10770 PRINT "that you specified. The computer will give you the option to add the records"
- 10780 PRINT "Only the records that meet the conditons you specified will be added."
- 10790 PRINT "If you want to add all the records do not put any condition on any of the "
- 10800 PRINT "fields.
- 10805 PRINT ""
- 10810 PRINT " If you do specify a condition for a field the computer will ask you if you "
- 10815 PRINT "want to OR the conditon with a condition of another field. If you chose the"
- 10820 PRINT "OR option only one of the conditions will need to be meet for the record to "
- 10825 PRINT "be acceptable. You may OR two or more conditions together."
- 10830 PRINT " If you use the OR option. Specify the or condition only once on the lowest"
- 10840 PRINT "number field that you are ORING together. For example if you wantto OR the "
- 10850 PRINT "second and fourth field specify the OR conditions on the second field not"
- 10855 PRINT "on the fourth field. See the manual for more information."
- 10865 PRINT ""
- 10870 PRINT "*********************** PRESS ANY KEY TO CONTINUE ************************"
- 10880 IF INKEY$ = "" GOTO 10880
- 10890 RETURN
- 10900 REM ************* PUT DISK IN DRIVE SUB
- 10905 IF HDISK = 2 THEN RETURN
- 10910 GOSUB 13000
- 10920 PRINT " ******** PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE *********"
- 10930 PRINT ""
- 10940 PRINT " THEN PRESS ANY KEY TO CONTINUE "
- 10950 PRINT ""
- 10960 PRINT " If the program data disk is already in the default disk drive then"
- 10965 PRINT " just press any key to continue."
- 10970 PRINT ""
- 10990 IF INKEY$ = "" GOTO 10990
- 10995 RETURN
- 11000 REM ******** LOAD KEYLIST *********
- 11010 GOSUB 13000
- 11100 A = 10
- 11105 PRINT "FILE : KEYLIST "
- 11110 GOSUB 2300
- 11120 GOSUB 2500
- 11130 FOR T = 1 TO 10000
- 11140 IF T > MRN GOTO 11900
- 11150 GET #1,T
- 11160 T1 = CVI(X$(1))
- 11170 T2 = CVI(X$(2))
- 11180 L$(T1,T2) = X$(3)
- 11185 IF T2 > MAXK(T1) THEN MAXK(T1) = T2
- 11190 NEXT T
- 11900 KD = 5
- 11935 CLOSE #1
- 11940 RETURN
- 12000 REM ****** PRINT SUBROUTINE *****
- 12010 PRINT "************* FILE : ";F$(A);"- ";"RECORD NUMBER: ";RN;" *************"
- 12020 FOR Q = 1 TO NREC(A)
- 12025 IF Q MOD 20 = 0 THEN GOSUB 12170
- 12030 PRINT Q; TAB(5) FLDN$(A,Q);
- 12040 ON FTY(A,Q) GOTO 12050,12070,12100,12130,12142
- 12050 PRINT TAB(26) X$(Q)
- 12060 GOTO 12150
- 12070 I%=CVI(X$(Q))
- 12075 PRINT TAB(25) I%;
- 12080 IF KY(A,Q) <> 2 THEN PRINT ""
- 12082 IF KY(A,Q) <> 2 THEN GOTO 12150
- 12084 T1 = KEYLIST(A,Q)
- 12085 IF I% < 0 THEN I% = 0
- 12086 W$ = L$(T1,I%)
- 12090 PRINT TAB(30) "key: ";W$
- 12095 GOTO 12150
- 12100 I!=CVS(X$(Q))
- 12110 PRINT TAB(25) I!
- 12120 GOTO 12150
- 12130 I#=CVD(X$(Q))
- 12140 PRINT TAB(25) I#
- 12141 GOTO 12150
- 12142 I#=CVD(X$(Q))
- 12144 PRINT TAB(26);
- 12146 PRINT USING "**$########.##";I#
- 12150 NEXT Q
- 12152 IF Q < 20 THEN RETURN
- 12153 PRINT""
- 12154 PRINT ""
- 12155 PRINT ""
- 12156 PRINT ""
- 12157 PRINT ""
- 12160 RETURN
- 12170 RETURN
- 12180 IF INKEY$ = "" GOTO 12180
- 12190 RETURN
- 12200 PRINT ""
- 12210 LPRINT ""
- 12220 PRINT "RECORD NUMBER: ";RN
- 12230 LPRINT "RECORD NUMBER: ";RN
- 12240 FOR Q = 1 TO NREC(A)
- 12250 PRINT Q;TAB(5) FLDN$(A,Q);
- 12260 LPRINT Q;TAB(5) FLDN$(A,Q);
- 12270 ON FTY(A,Q) GOTO 12280,12310,12350,12390,12425
- 12280 PRINT TAB(26) X$(Q)
- 12290 LPRINT TAB(26) X$(Q)
- 12300 GOTO 12480
- 12310 I%=CVI(X$(Q))
- 12312 PRINT TAB(25) I%;
- 12314 LPRINT TAB(25) I%;
- 12316 IF KY(A,Q) <> 2 THEN PRINT ""
- 12318 IF KY(A,Q) <> 2 THEN LPRINT ""
- 12320 IF KY(A,Q) <> 2 THEN GOTO 12480
- 12322 T1 = KEYLIST(A,Q)
- 12324 W$ = L$(T1,I%)
- 12326 PRINT TAB(30) "key: ";W$
- 12328 LPRINT TAB(30) "key: ";W$
- 12330 GOTO 12480
- 12340 GOTO 12480
- 12350 I!=CVS(X$(Q))
- 12360 PRINT TAB(25) I!
- 12370 LPRINT TAB(25) I!
- 12380 GOTO 12480
- 12390 I#=CVD(X$(Q))
- 12400 PRINT TAB(25) I#
- 12410 LPRINT TAB(25) I#
- 12420 GOTO 12480
- 12425 I#=CVD(X$(Q))
- 12430 PRINT TAB(26);
- 12440 PRINT USING "**$########.##";I#
- 12450 LPRINT TAB(26);
- 12460 LPRINT USING "**$########.##";I#
- 12480 NEXT Q
- 12490 RETURN
- 12500 PRINT ""
- 12510 LPRINT ""
- 12520 PRINT "RECORD # ";RN;" ";
- 12530 LPRINT "RECORD # ";RN;" ";
- 12540 FOR Q = 1 TO NREC(A)
- 12545 IF LEND(Q)= 5 THEN PRINT ""
- 12547 IF LEND(Q)= 5 THEN LPRINT ""
- 12548 T2 = CL(Q) + 6
- 12550 PRINT TAB(CL(Q))"<";Q;">";
- 12560 LPRINT TAB(CL(Q))"<";Q;">";
- 12570 ON FTY(A,Q) GOTO 12580,12610,12730,12770,12810
- 12580 PRINT TAB(T2) X$(Q);
- 12590 LPRINT TAB(T2) X$(Q);
- 12600 GOTO 12860
- 12610 I%=CVI(X$(Q))
- 12620 PRINT TAB(T2)I%;
- 12630 LPRINT TAB(T2)I%;
- 12660 IF KY(A,Q) <> 2 THEN GOTO 12860
- 12670 T1 = KEYLIST(A,Q)
- 12680 W$ = L$(T1,I%)
- 12685 T1 = CL(Q) + 11
- 12690 PRINT TAB(T1)"key: ";W$;
- 12700 LPRINT TAB(T1)"key: ";W$;
- 12720 GOTO 12860
- 12730 I!=CVS(X$(Q))
- 12740 PRINT TAB(T2)I!;
- 12750 LPRINT TAB(T2)I!;
- 12760 GOTO 12860
- 12770 I#=CVD(X$(Q))
- 12780 PRINT TAB(T2)I#;
- 12790 LPRINT TAB(T2)I#;
- 12800 GOTO 12860
- 12810 I#=CVD(X$(Q))
- 12820 PRINT TAB(T2) "";
- 12830 PRINT USING "**$########,.##";I#;
- 12840 LPRINT TAB(T2) "";
- 12850 LPRINT USING "**$########,.##";I#;
- 12860 NEXT Q
- 12870 RETURN
- 12880 PRINT " HOW MANY COLUMNS ARE THERE ON YOUR PRINTER "
- 12890 GOSUB 14100
- 12892 COLM = DT#
- 12895 RETURN
- 12900 REM ******* TAB CONTROL *******
- 12901 C = 15
- 12902 FOR T = 1 TO NREC(A)
- 12903 LEND(T) = 0
- 12905 CL(T)= C
- 12906 GOSUB 12910:PRINT T;CL(T); " RETURNED FROM 12910 "
- 12907 IF C > COLM THEN GOSUB 12970
- 12908 PRINT T;CL(T): NEXT T
- 12909 RETURN
- 12910 ON FTY(A,T) GOTO 12920,12930,12940,12950,12950
- 12920 C = C + FL(A,T) + 5
- 12925 RETURN
- 12930 C = C + 11
- 12933 IF KY(A,T) = 2 THEN C = C + 30
- 12935 RETURN
- 12940 C = C + 13
- 12945 RETURN
- 12950 C = C + 18
- 12952 RETURN
- 12970 CL(T)= 1
- 12972 C =1
- 12974 LEND(T) = 5
- 12975 GOSUB 12910
- 12980 RETURN
- 13000 REM ********* CLEAR SCREEN
- 13010 CLS
- 13020 RETURN
- 13100 REM ********* LOCATE
- 13110 LOCATE LI,1
- 13120 RETURN
- 13200 FOR T% = 1 TO 80
- 13210 PRINT CHR$(8);
- 13220 NEXT T%
- 13222 FOR T% = 1 TO 24
- 13223 PRINT CHR$(11);
- 13224 NEXT T%
- 13225 LI = LI - 1
- 13230 FOR T% = 1 TO LI
- 13240 PRINT CHR$(0)
- 13250 NEXT T%
- 13590 RETURN
- 13600 REM ****** CHECK FOR ASC0
- 13610 S4$ = INKEY$
- 13620 C2 = ASC(S4$)
- 13630 IF C2 = 83 THEN C = 1
- 13640 IF C2 = 82 THEN C = 6
- 13650 IF C2 = 75 THEN C = 19
- 13660 IF C2 = 77 THEN C = 4
- 13670 RETURN
- 14000 REM ******* INTEGER LESS THEN 100 CHECK ********
- 14010 MAX = 2
- 14020 ACT$ = "1234567890=<>^"
- 14023 IF NE = 0 THEN ACT$ = "1234567890"
- 14025 PRINT ">__<";
- 14030 GOTO 14500
- 14100 REM ******* INTEGER *******
- 14110 MAX = 8
- 14120 ACT$ = "1234567890-+,=<>^"
- 14123 IF NE = 0 THEN ACT$ = "1234567890-+,"
- 14125 PRINT ">________<";
- 14130 GOTO 14500
- 14200 REM ******* SINGLE PRECISION *******
- 14210 MAX = 10
- 14220 ACT$ = "1234567890-+,.%$=<>^"
- 14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 14225 PRINT ">__________<";
- 14230 GOTO 14500
- 14300 REM ******* DOUBLE PRECISION *******
- 14310 MAX = 20
- 14320 ACT$ = "1234567890-+,.%$=<>^"
- 14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 14325 PRINT ">____________________<";
- 14330 GOTO 14500
- 14500 REM ********** NUMBER CHECK **********
- 14505 A$ = ""
- 14510 K$(20) = " "
- 14515 KTMAX = 0
- 14520 FOR T9 = 1 TO MAX
- 14525 K$(T9) = " "
- 14530 NEXT T9
- 14535 DIG$ = "1234567890."
- 14540 DOTFLG = 0
- 14541 T2 = MAX + 1
- 14542 FOR T6 = 1 TO T2
- 14544 PRINT CHR$(CH);
- 14546 NEXT T6
- 14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
- 14560 KT = 0
- 14565 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
- 14570 KT = KT + 1
- 14575 REM
- 14580 W$ = INKEY$
- 14585 IF W$ = "" GOTO 14580
- 14590 C = ASC(W$)
- 14593 IF C = 0 THEN GOSUB 13600
- 14595 IF C = 13 GOTO 14660
- 14600 IF C = 17 OR C = 8 GOTO 14860
- 14605 IF C = 19 GOTO 14690
- 14610 IF C = 4 GOTO 14710
- 14615 IF C = 6 GOTO 14730
- 14620 IF C = 1 GOTO 14790
- 14625 IF KT > MAX GOTO 14575
- 14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
- 14635 K$(KT) = W$
- 14645 PRINT K$(KT);
- 14650 IF KT > KTMAX THEN KTMAX = KT
- 14655 GOTO 14570
- 14660 REM ********** RETURN **********
- 14670 FOR T9 = 1 TO KTMAX
- 14675 A$ = A$ + K$(T9)
- 14676 IF K$(T9) = "^" GOTO 15830
- 14677 IF K$(T9) = ">" GOTO 15950
- 14678 IF K$(T9) = "=" GOTO 15800
- 14679 IF K$(T9) = "<" GOTO 15900
- 14680 NEXT T9
- 14681 IF KTMAX = 0 THEN PRINT "1"
- 14682 IF KTMAX = 0 THEN DT# = 1
- 14683 IF KTMAX = 0 THEN RETURN
- 14684 PRINT ""
- 14685 GOTO 14905
- 14690 REM ********* MOVE CURSE BACK ********
- 14695 IF KT = 1 GOTO 14575
- 14700 KT = KT - 1
- 14703 PRINT CHR$(CH);
- 14705 GOTO 14575
- 14710 REM ********* MOVE CURSER FORWARD *********
- 14715 IF KT >= MAX GOTO 14575
- 14716 IF KT > (KTMAX + 1) GOTO 14575
- 14718 PRINT K$(KT);
- 14720 KT = KT + 1
- 14725 GOTO 14575
- 14730 REM ********** INSERT ***********
- 14733 IF KT > KTMAX GOTO 14575
- 14735 X9 = MAX
- 14740 WHILE X9 > KT
- 14745 X9 = X9 - 1
- 14750 K$(X9 + 1) = K$(X9)
- 14755 WEND
- 14760 K$(KT) = " "
- 14767 KTMAX = KTMAX + 1
- 14769 IF KTMAX > MAX THEN KTMAX = MAX
- 14770 FOR T9 = KT TO KTMAX
- 14775 PRINT K$(T9);
- 14780 NEXT T9
- 14781 T6 = (KTMAX - KT) + 1
- 14782 FOR T7 = 1 TO T6
- 14783 PRINT CHR$(CH);
- 14784 NEXT T7
- 14785 GOTO 14575
- 14790 REM ********** DELETE ***********
- 14793 IF KT > KTMAX GOTO 14575
- 14794 IF KTMAX = 1 GOTO 14575
- 14795 K$(MAX + 1) = ""
- 14800 X9 = KT
- 14805 WHILE X9 <= MAX
- 14810 K$(X9) = K$(X9 + 1)
- 14815 X9 = X9 + 1
- 14820 WEND
- 14830 KTMAX = KTMAX - 1
- 14835 FOR T9 = KT TO KTMAX
- 14840 PRINT K$(T9);
- 14845 NEXT T9
- 14850 PRINT "_";
- 14851 T7 = (KTMAX - KT) + 2
- 14852 FOR T8 = 1 TO T7
- 14853 PRINT CHR$(CH);
- 14854 NEXT T8
- 14855 GOTO 14575
- 14860 REM ********* BACKSPACE ********
- 14865 IF KT = 1 GOTO 14575
- 14870 KT = KT - 1
- 14875 PRINT CHR$(CH);
- 14877 K$(KT) = " "
- 14880 PRINT "_";
- 14883 PRINT CHR$(CH);
- 14885 GOTO 14575
- 14890 REM ******* INPUT NOT ACCEPTABLE ********
- 14895 PRINT CHR$(7);
- 14900 GOTO 14580
- 14905 REM ********* CLEAR STRINGS ********
- 14910 MAX = LEN(A$)
- 14915 D2$ = ""
- 14920 D1$ = ""
- 14925 DFLG = 0
- 14930 FOR Q93 = 1 TO MAX
- 14935 R$ = MID$(A$,Q93,1)
- 14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
- 14945 IF R$ = "." OR DFLG = 1 GOTO 14965
- 14950 IF DFLG = 1 GOTO 14965
- 14955 D2$ = D2$ + R$
- 14960 GOTO 14975
- 14965 D1$ = D1$ + R$
- 14970 DFLG = 1
- 14975 NEXT Q93
- 14980 DA# = VAL(D2$)
- 14985 D1# = VAL(D1$)
- 14990 DT# = DA# + D1#
- 14995 IF K$(1) = "-" THEN DT# = -DT#
- 14997 RETURN
- 15000 REM ********** ALPHANUMERIC CHECK **************
- 15010 MAX = FL(A,Q)
- 15020 GOTO 15040
- 15030 REM ******** MAX SET IN PROGRAM ********
- 15040 A$ = ""
- 15050 PRINT ">";
- 15060 FOR N9 = 1 TO MAX
- 15065 K$(N9) = ""
- 15070 PRINT "_";
- 15080 NEXT N9
- 15090 PRINT "<";
- 15100 T2 = MAX + 1
- 15110 FOR T4 = 1 TO T2
- 15120 PRINT CHR$(CH);
- 15125 NEXT T4
- 15130 KT = 0
- 15135 KTMAX = 1
- 15140 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
- 15150 KT = KT + 1
- 15160 PRINT TAB(KT+1)"";
- 15170 K$ = INKEY$
- 15180 IF K$ = "" GOTO 15170
- 15190 C = ASC(K$)
- 15195 IF C = 0 THEN GOSUB 13600
- 15200 IF C = 13 GOTO 15310
- 15210 IF C = 17 OR C = 8 GOTO 15710
- 15220 IF C = 19 GOTO 15370
- 15230 IF C = 4 GOTO 15410
- 15240 IF C = 6 GOTO 15450
- 15250 IF C = 1 GOTO 15570
- 15260 IF KT > MAX GOTO 15160
- 15270 K$(KT) = K$
- 15290 PRINT K$(KT);
- 15295 IF KT > KTMAX THEN KTMAX = KT
- 15300 GOTO 15150
- 15310 REM ********** RETURN **********
- 15320 FOR T9 = 1 TO MAX
- 15330 A$ = A$ + K$(T9)
- 15332 IF K$(T9) = "^" GOTO 15830
- 15333 IF K$(T9) = ">" GOTO 15950
- 15335 IF K$(T9) = "=" GOTO 15850
- 15338 IF K$(T9) = "<" GOTO 15900
- 15340 NEXT T9
- 15350 PRINT ""
- 15360 RETURN
- 15370 REM ********* MOVE CURSE BACK ********
- 15380 IF KT = 1 GOTO 15160
- 15385 KT = KT - 1
- 15390 PRINT CHR$(CH);
- 15400 GOTO 15160
- 15410 REM ********* MOVE CURSER FORWARD *********
- 15420 IF KT >= MAX GOTO 15160
- 15425 IF KT > KTMAX GOTO 15160
- 15427 PRINT K$(KT);
- 15430 KT = KT + 1
- 15440 GOTO 15160
- 15450 REM ********** INSERT ***********
- 15460 X9 = MAX
- 15470 WHILE X9 > KT
- 15480 X9 = X9 - 1
- 15490 K$(X9 + 1) = K$(X9)
- 15500 WEND
- 15510 K$(KT) = " "
- 15520 KTMAX = KTMAX + 1
- 15525 IF KTMAX > MAX THEN KTMAX = MAX
- 15530 FOR T9 = KT TO KTMAX
- 15540 PRINT K$(T9);
- 15550 NEXT T9
- 15552 T6 = (KTMAX - KT) +1
- 15554 FOR T7 = 1 TO T6
- 15556 PRINT CHR$(CH);
- 15558 NEXT T7
- 15560 GOTO 15160
- 15570 REM ********** DELETE ***********
- 15575 IF KT > KTMAX GOTO 15170
- 15578 IF KTMAX = 1 GOTO 15160
- 15580 K$(MAX + 1) = ""
- 15590 X9 = KT
- 15600 WHILE X9 <= KTMAX
- 15610 K$(X9) = K$(X9 + 1)
- 15620 X9 = X9 + 1
- 15630 WEND
- 15650 KTMAX = KTMAX - 1
- 15660 FOR T9 = KT TO KTMAX
- 15670 PRINT K$(T9);
- 15680 NEXT T9
- 15690 PRINT "_";
- 15692 T7 = (KTMAX - KT) + 2
- 15694 FOR T6 = 1 TO T7
- 15696 PRINT CHR$(CH);
- 15698 NEXT T6
- 15700 GOTO 15160
- 15710 REM ********* BACKSPACE ********
- 15720 IF KT = 1 GOTO 15160
- 15725 K$(KT) = " "
- 15730 KT = KT - 1
- 15735 K$(KT) = " "
- 15740 PRINT CHR$(CH);
- 15750 PRINT "_";
- 15755 PRINT CHR$(CH);
- 15760 GOTO 15160
- 15800 REM "********* SAME ENTRY AS LAST RECORD ************"
- 15810 DT# = X(N)
- 15820 RETURN
- 15830 REM ******** SAME ENTRY AS LAST RECORD OVER ONE COLUMN *****
- 15835 DT# = X(N + 1)
- 15840 RETURN
- 15850 REM "********* SAME ENTRY AS LAST RECORD ALFANUMERIC **********"
- 15860 A$ = CK$(N)
- 15870 RETURN
- 15900 REM ****** RESTART DATA ENTRY **********
- 15910 REFLG = 1
- 15915 IF NE = 0 GOTO 15340
- 15920 RETURN
- 15950 REM ********* ABORT NEW DATA ENTRY **********
- 15960 IF NE = 0 GOTO 15340
- 15970 ABORTFLG = 1
- 15980 RETURN
- 16000 GOSUB 13000
- 16010 PRINT "*********** MAKE SURE YOUR PRINTER IS ON **************"
- 16020 PRINT ""
- 16030 PRINT "******************** WITH PAPER ***********************"
- 16040 PRINT ""
- 16050 PRINT "********** PRESS ANY KEY TO START PRINTING ************"
- 16055 PRINT ""
- 16057 PRINT " ******* PRESS THE LETTER A TO ABORT *******"
- 16070 T$ = INKEY$
- 16073 IF T$ = "" GOTO 16070
- 16075 PRINT T$
- 16085 IF T$ = "A" THEN GOTO 3010
- 16090 RETURN
- 16200 REM ********* PRINT OUT FIELDS
- 16205 T2 = 1
- 16210 FOR T = 1 TO NREC(A)
- 16220 PRINT TAB(T2) T;"-";FLDN$(A,T);
- 16230 IF T MOD 3 = 0 THEN PRINT ""
- 16235 IF T MOD 3 = 0 THEN T2 = -25
- 16237 T2 = T2 + 26
- 16340 NEXT T
- 16350 RETURN
- 26000 REM ******* ON ERROR ROUTINE ************
- 26100 EFLG = 1
- 26200 PRINT "********** END OF FILE ***********"
- 26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
- 26204 IF INKEY$ = "" GOTO 26204
- 26210 GOTO 3010
- 26500 REM ********* ON ERROR SUBROUTINE ***********
- 26600 PRINT "********** END OF FILE ***********"
- 26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
- 26620 IF INKEY$ = "" GOTO 26620
- 26635 EFLG = 1
- 26640 RETURN
- 26800 REM ********** ON ERROR GOTO **************
- 26900 PRINT "************ RECORD NOT FOUND *************"
- 50000 REM ********** INTRO
- 50010 GOSUB 13000
- 50100 PRINT " S C A N P R O G R A M 3.0 "
- 50105 PRINT ""
- 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
- 50120 PRINT ""
- 50130 PRINT "This program is licensed FREE to all users with some restrictions"
- 50165 PRINT " See the manual for more information on the license."
- 50167 PRINT ""
- 50950 PRINT "***************** PRESS ANY KEY TO CONTINUE *******************";
- 50960 IF INKEY$ = "" GOTO 50960
- 50970 RETURN
- 51000 REM ******* DONE
- 51100 CLOSE
- 51105 GOSUB 13000
- 51110 PRINT " -BYE, Have a nice day
- 51120 END
- 50960
- 50970 RETURN
- 51000 REM ******* DONE
- 51100 CLOSE
- 51105 GOSUB 13000
- 51110 PRINT " -BYE, Have a nice day
-